home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
New Star Software Collection
/
NSS_Collection.iso
/
3-004 ms visual basic pro 30
/
4.imz
/
4.IMA
/
CPYSTRU.FR_
/
CPYSTRU.bin
Wrap
Text File
|
1993-04-28
|
6KB
|
211 lines
VERSION 2.00
Begin Form fCpyStru
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Copy Table(s)"
ClientHeight = 3300
ClientLeft = 2730
ClientTop = 2235
ClientWidth = 6525
ControlBox = 0 'False
Height = 3705
Left = 2670
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3278.104
ScaleMode = 0 'User
ScaleWidth = 6554.436
Top = 1890
Width = 6645
Begin CheckBox cCopyData
BackColor = &H00C0C0C0&
Caption = "Copy Data"
Height = 255
Left = 3675
TabIndex = 9
Top = 2310
Value = 1 'Checked
Width = 1380
End
Begin TextBox cDataBase
BackColor = &H00FFFFFF&
Height = 285
Left = 3045
TabIndex = 1
Tag = "OL"
Top = 420
Width = 3375
End
Begin CommandButton CloseButton
Cancel = -1 'True
Caption = "&Close"
Height = 375
Left = 4830
TabIndex = 4
Top = 2730
Width = 1515
End
Begin CommandButton OkayButton
Caption = "&OK"
Default = -1 'True
Height = 375
Left = 3045
TabIndex = 3
Top = 2730
Width = 1485
End
Begin TextBox cConnect
BackColor = &H00FFFFFF&
Height = 540
Left = 3045
MultiLine = -1 'True
TabIndex = 0
Tag = "OL"
Top = 1155
Width = 3375
End
Begin CheckBox cCopyIndexes
BackColor = &H00C0C0C0&
Caption = "Copy Indexes"
Height = 255
Left = 3675
TabIndex = 2
Top = 1890
Value = 1 'Checked
Width = 1605
End
Begin ListBox cTableList
BackColor = &H00FFFFFF&
Height = 2760
Left = 105
MultiSelect = 2 'Extended
Sorted = -1 'True
TabIndex = 5
Tag = "OL"
Top = 420
Width = 2775
End
Begin Label ServerLabel
BackColor = &H00C0C0C0&
Caption = "Target Connect String:"
Height = 255
Left = 3045
TabIndex = 8
Top = 840
Width = 2115
End
Begin Label DataBaseLabel
BackColor = &H00C0C0C0&
Caption = "Target Database:"
Height = 225
Left = 3045
TabIndex = 7
Top = 105
Width = 1725
End
Begin Label TableListLabel
BackColor = &H00C0C0C0&
Caption = "Tables:"
Height = 225
Index = 0
Left = 105
TabIndex = 6
Top = 105
Width = 2295
End
End
Option Explicit
Sub CloseButton_Click ()
RefreshTables fTables.cTableList, True 'just in case some were added
Unload Me
End Sub
Sub Form_Load ()
Dim i As Integer
RefreshTables cTableList, False
cDataBase = gstDBName
cConnect = gCurrentDB.Connect
Left = (Screen.Width - Width) / 2
Top = (Screen.Height - Height) / 2
End Sub
Sub Form_Paint ()
Outlines Me
End Sub
Sub OkayButton_Click ()
Dim i As Integer
Dim diff_db As Integer
Dim to_nm As String
Dim to_db As database
Dim Connect As String
On Error GoTo OkayErr
MsgBar "Copying Table(s)", True
SetHourglass Me
If cDataBase = "" Or cDataBase = gstDBName Then
Set to_db = gCurrentDB
diff_db = False
Else
Set to_db = OpenDatabase(cDataBase, False, False, cConnect + ";LoginTimeout=" & glLoginTimeout)
to_db.QueryTimeout = glQueryTimeout
diff_db = True
End If
For i = 0 To cTableList.ListCount - 1
If cTableList.Selected(i) Then
If diff_db = False Then
to_nm = InputBox("Enter New Table Name:")
If to_nm = "" Then GoTo skipit
Else
to_nm = (cTableList.List(i))
End If
Else
GoTo skipit
End If
SetHourglass Me
If CopyStruct(gCurrentDB, to_db, (cTableList.List(i)), to_nm, (cCopyIndexes)) = True Then
If cCopyData = 1 Then
If CopyData(gCurrentDB, to_db, (cTableList.List(i)), to_nm) = False Then
Beep
MsgBox "Copy of Data To " + (cTableList.List(i)) + " was UnSuccessful!"
End If
End If
ResetMouse Me
MsgBox "Copy of " + (cTableList.List(i)) + " Structure was Successful!"
cTableList.Selected(i) = False
Else
ResetMouse Me
Beep
MsgBox "Copy of " + (cTableList.List(i)) + " UnSuccessful!"
End If
skipit:
Next
GoTo OkayEnd
OkayErr:
ShowError
Resume OkayEnd
OkayEnd:
On Error Resume Next
MsgBar "", False
End Sub